home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / tp5tsr.zip / TSR2.PAS next >
Pascal/Delphi Source File  |  1989-05-27  |  13KB  |  315 lines
  1. _CREATING TSR PROGRAMS, PART II_
  2. by Ken L. Pottebaum
  3.  
  4. [LISTING ONE]
  5.  
  6.  
  7. UNIT TSRUnit; {Create TSR programs with Turbo Pascal 5.0 & TSRUnit}
  8. INTERFACE {=======================================================}
  9. {
  10. The author and any distributor of this software assume no responsi-
  11. bility for damages resulting from this software or its use due to
  12. errors, omissions, incompatibility with other software or with
  13. hardware, or misuse; and specifically disclaim any implied warranty
  14. of fitness for any particular purpose or application.
  15. }
  16. USES DOS, CRT;
  17. CONST
  18. {*** Shift key combination codes.                                 }
  19.   AltKey = 8;  CtrlKey = 4;  LeftKey = 2;  RightKey = 1;
  20.  
  21.   TSRVersion : WORD = $0203;       {Low byte.High byte = 2.03     }
  22.  
  23. TYPE
  24.   String80  = STRING[80];
  25.   ChrWords  = RECORD CASE INTEGER OF
  26.                   1: ( W: WORD );
  27.                   2: ( C: CHAR; A: BYTE );
  28.               END;
  29.   LineWords = ARRAY[1..80] OF ChrWords;
  30.   WordFuncs = FUNCTION : WORD;
  31.  
  32. VAR
  33.   TSRScrPtr : POINTER; {Pointer to saved screen image.            }
  34.   TSRChrPtr : POINTER; {Pointer to first character to insert.     }
  35.   TSRMode   : BYTE;    {Video mode --------- before TSR popped up.}
  36.   TSRWidth  : BYTE;    {Number of screen columns-- " "    "    " .}
  37.   TSRPage   : BYTE;    {Active video page number-- " "    "    " .}
  38.   TSRColumn : BYTE;    {Cursor column number ----- " "    "    " .}
  39.   TSRRow    : BYTE;    {Cursor row number -------- " "    "    " .}
  40. {
  41. ** Procedure for installing the TSR program.                      }
  42. PROCEDURE TSRInstall( TSRName : STRING;   {Name or title for TSR. }
  43.                       TSRFunc : WordFuncs;{Ptr to FUNCTION to call}
  44.                       ShiftComb: BYTE;    {Hot key--shift key comb}
  45.                       KeyChr   : CHAR );  {Hot Key--character key.}
  46. {
  47.   ShiftComb and KeyChr specify the default hot keys for the TSR.
  48.   ShiftComb may be created by adding or ORing the constants AltKey,
  49.   CtrlKey, LeftKey, and RightKey together.  KeyChr may be
  50.   characters 0-9 and A-Z.
  51.  
  52.   The default hot keys may be overridden when the TSR is installed
  53.   by specifying optional parameters on the command line.  The
  54.   parameter format is:
  55.                        [/A] [/C] [/R] [/L] [/"[K["]]]
  56.   The square brackets surround optional items--do not include them.
  57.   Any characters between parameters are ignored. The order of the
  58.   characters does not matter; however, the shift keys specified are
  59.   cummulative and the last character key "K" specified is the used.
  60. }
  61. {
  62. ** Functions for checking status of printer LPT1.                 }
  63. FUNCTION PrinterOkay:   BOOLEAN; {Returns TRUE if printer is okay.}
  64. FUNCTION PrinterStatus: BYTE;    {Returns status of printer.
  65.   Definition of status byte bits (1 & 2 are not used), if set then:
  66.  Bit: -- 7 ---  ---- 6 ----  -- 5 ---  -- 4 ---  -- 3 --  --- 0 ---
  67.       Not busy  Acknowledge  No paper  Selected  I/O Err. Timed-out
  68. }
  69. {
  70. ** Routines for obtaining one row of screen characters.           }
  71. FUNCTION ScreenLineStr( Row: BYTE ): String80; {Returns char. str.}
  72. PROCEDURE ScreenLine( Row: BYTE; VAR Line: LineWords; {Returns    }
  73.                                  VAR Words: BYTE );   {chr & color}
  74.  
  75.  
  76. [LISTING TWO]
  77.  
  78. PROGRAM TSRDemo;  {An example TSR program created using TSRUnit.   }
  79.  
  80. {$M $0800,0,0}   {Set stack and heap size for demo program.        }
  81.  
  82. USES CRT, DOS, TSRUNIT; {Specify the TSRUNIT in the USES statement.}
  83.                         {Do not use the PRINTER unit, instead treat}
  84.                         {the printer like a file; i.e. use the     }
  85.                         {Assign, Rewrite, and Close procedures.    }
  86.  
  87. CONST  DemoPgmName : STRING[16] = 'TSR Demo Program';
  88.  
  89. VAR
  90.   Lst      : TEXT;      {Define variable name for the printer.     }
  91.   TextFile : TEXT;      {  "        "     "    "   a data file.    }
  92.   InsStr   : STRING;    {Storage for characters to be inserted into}
  93.                         {keyboard input stream--must be a gobal or }
  94.                         {heap variable.                            }
  95.  
  96. FUNCTION IOError: BOOLEAN;    {Provides a message when an I/O error}
  97. VAR  i : WORD;                {occurs.                             }
  98. BEGIN
  99.   i       := IOResult;
  100.   IOError := FALSE;
  101.   IF i <> 0 THEN BEGIN
  102.     Writeln('I/O Error No. ',i);
  103.     IOError := TRUE;
  104.   END;
  105. END;  {OurIOResult.}
  106. {
  107. ***** Demo routine to be called when TSRDemo is popped up.
  108.       be compiled as a FAR FUNCTION that returns a WORD containing
  109.       the number of characters to insert into the keyboard input
  110.       stream.
  111. }
  112. {$F+} FUNCTION DemoTasks: WORD; {$F-}
  113. CONST
  114.   FileName : STRING[13] = ' :TSRDemo.Dat';
  115.   EndPos = 40;
  116.   Wx1 = 15; Wy1 = 2;   Wx2 = 65; Wy2 = 23;
  117. VAR
  118.   Key, Drv          : CHAR;
  119.   Done, IOErr       : BOOLEAN;
  120.   InputPos, RowNumb : INTEGER;
  121.   DosVer            : WORD;
  122.   InputString       : STRING;
  123.  
  124.   PROCEDURE ClearLine; {Clears current line and resets line pointer}
  125.   BEGIN
  126.     InputString := '';     InputPos := 1;
  127.     GotoXY( 1, WhereY );   ClrEol;
  128.   END;
  129.  
  130. BEGIN
  131.   DemoTasks   := 0;             {Default to 0 characters to insert.}
  132.   Window( Wx1, Wy1, Wx2, Wy2 ); {Set up the screen display.        }
  133.   TextColor( Black );
  134.   TextBackground( LightGray );
  135.   LowVideo;
  136.   ClrScr;                      {Display initial messages.          }
  137.   Writeln;
  138.   Writeln('  Example Terminate & Stay-Resident (TSR) program');
  139.   Writeln(' --written with Turbo Pascal 5.0 and uses TSRUnit.');
  140.   Window( Wx1+1, Wy1+4, Wx2-1, Wy1+12);
  141.   TextColor( LightGray );
  142.   TextBackground( Black );
  143.   ClrScr;                      {Display function key definitions.  }
  144.   Writeln;
  145.   Writeln('    Function key definitions:');
  146.   Writeln('        [F1]  Write message to TSRDEMO.DAT');
  147.   Writeln('        [F2]    "     "     to printer.');
  148.   Writeln('        [F3]  Read from saved screen.');
  149.   Writeln('        [F8]  Exit and insert text.');
  150.   Writeln('        [F10] Exit TSR and keep it.');
  151.   Write(  '        or simply echo your input.');
  152.  
  153.                                {Create active display window.      }
  154.   Window( Wx1+1, Wy1+14, Wx2-1, Wy2-1 );
  155.   ClrScr;
  156.                                {Display system information.        }
  157.   Writeln('TSRUnit Version: ', Hi(TSRVersion):8, '.',
  158.                                Lo(TSRVersion):2 );
  159.   Writeln('Video Mode, Page:', TSRMode:4, TSRPage:4 );
  160.   Writeln('Cursor Row, Col.:', TSRRow:4, TSRColumn:4 );
  161.  
  162.   DosVer := DosVersion;
  163.   Writeln('DOS Version:     ', Lo(DosVer):8, '.', Hi(DosVer):2 );
  164.  
  165.   InputString := '';          {Initialize variables.               }
  166.   InputPos    := 1;
  167.   Done        := False;
  168.  
  169.   REPEAT                      {Loop for processing keystrokes.     }
  170.     GotoXY( InputPos, WhereY );    {Move cursor to input position. }
  171.     Key := ReadKey;                {Wait for a key to be pressed.  }
  172.     IF Key = #0 THEN BEGIN         {Check for a special key.       }
  173.       Key := ReadKey;              {If a special key, get auxiliary}
  174.       CASE Key OF                  {byte to identify key pressed.  }
  175.  
  176. {Cursor Keys and simple editor.}
  177. {Home}  #71: InputPos := 1;
  178. {Right} #75: IF InputPos > 1 THEN Dec( InputPos );
  179. {Left}  #77: IF (InputPos < Length( InputString ))
  180.                 OR ((InputPos = Length( InputString ))
  181.                     AND (InputPos < EndPos )) THEN Inc( InputPos );
  182. {End}   #79: BEGIN
  183.                InputPos := Succ( Length( InputString ) );
  184.                IF InputPos > EndPos THEN InputPos := EndPos;
  185.              END;
  186. {Del}   #83: BEGIN
  187.                Delete( InputString, InputPos, 1 );
  188.                Write( Copy( InputString, InputPos, EndPos ), ' ');
  189.              END;
  190.  
  191. {Function Keys--TSRDemo's special features.}
  192. {F1}    #59: BEGIN                 {Write short message to a file. }
  193.                ClearLine;
  194.                REPEAT
  195.                  Write('Enter disk drive:  ',FileName[1] );
  196.                  Drv := UpCase( ReadKey );  Writeln;
  197.                  IF Drv <> #13 THEN FileName[1] := Drv;
  198.                  Writeln('Specifying an invalid drive will cause your');
  199.                  Write('system to crash.  Use drive ',
  200.                         FileName[1], ': ?  [y/N] ');
  201.                  Key := UpCase( ReadKey );  Writeln( Key );
  202.                UNTIL Key = 'Y';
  203.                Writeln('Writing to ',FileName );
  204.                {$I-}                         {Disable I/O checking.}
  205.                Assign( TextFile, 'TSRDemo.Dat' );
  206.                IF NOT IOError THEN BEGIN     {Check for error.     }
  207.                  Rewrite( TextFile );
  208.                  IF NOT IOError THEN BEGIN
  209.                    Writeln(TextFile,'File was written by TSRDemo.');
  210.                    IOErr := IOError;
  211.                    Close( TextFile );
  212.                    IOErr := IOError;
  213.                  END;
  214.                END;
  215.                {$I+}                 {Enable standard I/O checking.}
  216.                Writeln('Completed file operation.');
  217.              END;  {F1}
  218.  
  219. {F2}    #60: BEGIN {Print a message, use TSRUnit's auxiliary       }
  220.                    {function PrinterOkay to check printer status.  }
  221.                ClearLine;
  222.                Writeln('Check printer status, then print if okay.');
  223.                IF PrinterOkay THEN BEGIN  {Check if printer is okay}
  224.                  Assign( Lst, 'LPT1' );   {Define printer device.  }
  225.                  Rewrite( Lst );          {Open printer.           }
  226.                  Writeln( Lst, 'Printing performed from TSRDemo');
  227.                  Close( Lst );            {Close printer.          }
  228.                END
  229.                ELSE Writeln('Printer is not ready.');
  230.                Writeln( 'Completed print operation.' );
  231.              END;  {F2}
  232.  
  233. {F3}    #61: BEGIN {Display a line from the saved screen image--not}
  234.                    {valid if the TSR was popped up while the       }
  235.                    {display was in a graphics mode.                }
  236.                ClearLine;
  237.                CASE TSRMode OF    {Check video mode of saved image.}
  238.                  0..3,
  239.                  7: BEGIN
  240.                       {$I-}
  241.                       REPEAT
  242.                         Writeln('Enter row number [1-25] from ');
  243.                         Write('which to copy characters:  ');
  244.                         Readln( RowNumb );
  245.                       UNTIL NOT IOError;
  246.                       {$I+}
  247.                       IF RowNumb <= 0 THEN RowNumb := 1;
  248.                       IF RowNumb > 25 THEN RowNumb := 25;
  249.                       Writeln( ScreenLineStr( RowNumb ) );
  250.                     END;
  251.                ELSE Writeln('Not valid for graphics modes.');
  252.                END;  {CASE TSRMode}
  253.              END;  {F3}
  254. {F8}    #66: BEGIN {Exit and insert string into keyboard buffer.}
  255.                ClearLine;
  256.                Writeln('Enter characters to insert;');
  257.                Writeln('Up to 255 character may be inserted.');
  258.                Writeln('Terminate input string by pressing [F8].');
  259.                InsStr := '';
  260.                REPEAT                     {Insert characters into a}
  261.                  Key := ReadKey;          {until [F8] is pressed.  }
  262.                  IF Key = #0 THEN BEGIN     {Check for special key.}
  263.                    Key := ReadKey;          {Check if key is [F8]. }
  264.                    IF Key = #66 THEN Done := TRUE; {[F8] so done.  }
  265.                  END
  266.                  ELSE BEGIN {Not special key, add it to the string.}
  267.                    IF Length(InsStr) < Pred(SizeOf(InsStr)) THEN
  268.                    BEGIN
  269.                      IF Key = #13 THEN Writeln
  270.                      ELSE Write( Key );
  271.                      InsStr := InsStr + Key;
  272.                    END
  273.                    ELSE Done := TRUE; {Exceeded character limit.   }
  274.                  END;
  275.                UNTIL Done;
  276.                DemoTasks := Length( InsStr );  {Return no. of chr. }
  277.                TSRChrPtr := @InsStr[1];        {Set ptr to 1st chr.}
  278.              END;  {F8}
  279.  
  280. {F10}   #68: Done := TRUE; {Exit and Stay-Resident.                }
  281.  
  282.       END;  {CASE Key}
  283.     END  {IF Key = #0}
  284.     ELSE BEGIN   {Key pressed was not a special key--just echo it. }
  285.       CASE Key OF
  286. {BS}    #08: BEGIN  {Backspace}
  287.                IF InputPos > 1 THEN BEGIN
  288.                  Dec( InputPos );
  289.                  Delete( InputString, InputPos, 1 );
  290.                  GotoXY( InputPos, WhereY );
  291.                  Write( Copy( InputString, InputPos, EndPos ), ' ');
  292.                END;
  293.              END;  {BS}
  294. {CR}    #13: BEGIN  {Enter}
  295.                Writeln;
  296.                InputString := '';
  297.                InputPos    := 1;
  298.              END;  {CR}
  299. {Esc}   #27: ClearLine;
  300.       ELSE
  301.         IF Length( InputString ) >= EndPos THEN
  302.           Delete( InputString, EndPos, 1 );
  303.         Insert( Key, InputString, InputPos );
  304.         Write( Copy( InputString, InputPos, EndPos ) );
  305.         IF InputPos < EndPos THEN
  306.           Inc( InputPos );
  307.       END;  {CASE...}
  308.     END;  {ELSE BEGIN--Key <> #0}
  309.     UNTIL Done;
  310. END;  {DemoTasks.}
  311.  
  312. BEGIN
  313.   TSRInstall( DemoPgmName, DemoTasks, AltKey, 'E' );
  314. END.  {TSRDemo.}
  315.